;(define ventana (make-graphics-device 'x))
(define ventana (make-graphics-device 'win32))

(define make-rect list)
(define origin first)
(define horiz second)
(define vert third)

(define make-vector cons)
(define xcor car)
(define ycor cdr)

(define make-segment cons)
(define seg-start car)
(define seg-end cdr)

(define (+vect v1 v2)
	(make-vector (+ (xcor v1) (xcor v2))
				 (+ (ycor v1) (ycor v2))
	)	
)

(define (-vect v1 v2)
	(+vect v1 (scale -1 v2))
)

(define (scale x v)
	(make-vector (* x (xcor v))
				 (* x (ycor v))
	)
)

(define (drawline start end)
	(graphics-draw-line ventana
		(xcor start)(ycor start)
		(xcor end)  (ycor end)
	)
)

(define (coord-map rect)
	(lambda (point)
		(+vect
			(+vect (scale (xcor point)
						  (horiz rect))
				   (scale (ycor point)
						  (vert rect))
			) 
			(origin rect)
		)
	)
)

(define (make-picture seglist)
	(lambda (rect)
		(map
			(lambda (segment) 
				(drawline  ((coord-map rect)(seg-start segment))
						   ((coord-map rect)(seg-end segment))
				)
			)
		seglist
		)
	)
)

(define empty-picture (make-picture '()))

(define (rotate90 pict)
	(lambda (rect)
		(pict (make-rect 
				(+vect (origin rect) (horiz rect))
				(vert rect)
				(scale -1 (horiz rect)))
		)
	)
)

(define (repeated proc n)
	(lambda (thing)
		(if (= n 0) thing
			((repeated proc (-1+ n)) (proc thing))
		)
	)
)

(define rotate180 (repeated rotate90 2))
(define rotate270 (repeated rotate90 3))

(define (flip pict)
	(lambda (rect)
		(pict (make-rect 
				(+vect (origin rect) (horiz rect))
				(scale -1 (horiz rect))
				(vert rect))
		)
	)	
)

(define (together pict1 pict2)
	(lambda (rect)
		(pict1 rect)
		(pict2 rect)
	)
)

(define (beside pict1 pict2 a)
	(lambda (rect)
		(pict1 (make-rect
				(origin rect)
				(scale a (horiz rect))
				(vert rect))
		)
		(pict2 (make-rect
				(+vect (origin rect)
					   (scale a (horiz rect)))
				(scale (- 1 a) (horiz rect))
				(vert rect))
		)
	)
)


(define (above pict1 pict2 a)
	(rotate270 (beside 
					(rotate90 pict1)
					(rotate90 pict2)
					a)
	)
)

(define (4pict pict1 rot1 pict2 rot2 pict3 rot3 pict4 rot4)
	(beside (above ((repeated rotate90 rot1) pict1)
				   ((repeated rotate90 rot2) pict2)
					.5)
			(above ((repeated rotate90 rot3) pict3)
				   ((repeated rotate90 rot4) pict4)
					.5)
			.5)
)

(define (4same pict rot1 rot2 rot3 rot4)
	(4pict pict rot1 pict rot2 pict rot3 pict rot4)
)

(define (up-push pict n)
	(if (= n 0) pict
		(above (up-push pict (-1+ n)) pict .25)
	)
)

(define (right-push pict n)
	(if (= n 0)
		pict
		(beside pict (right-push pict (-1+ n)) .75)
	)
)

(define (corner-push pict n)
	(if (= n 0)
		pict
		(above
			(beside (up-push pict n)
					(corner-push pict (-1+ n))
					.75)
			(beside pict
					(right-push pict (-1+ n))
					.75)
			.25)
	)
)

(define (square-limit pict n)
	(4same (corner-push pict n) 1 2 0 3 )
)

(define screen (make-rect
					(make-vector -1 -1)
					(make-vector 2 0)
					(make-vector 0 2))
)

(define outline-picture
	(make-picture (list (make-segment (make-vector 0 0)
									  (make-vector 0 1))
						(make-segment (make-vector 0 1)
									  (make-vector 1 1))
						(make-segment (make-vector 1 1)
									  (make-vector 1 0))
						(make-segment (make-vector 1 0)
									  (make-vector 0 0))
					)
	)
)

(define (draw-pict pict)
	(pict screen)
)

;Patters

(define wedge (make-picture
				(list (make-segment (make-vector 0 0)
									(make-vector .5 1))
					  (make-segment (make-vector .5 1)
									(make-vector 1 0))
				)
			)
)

(define line (make-picture
				(list (make-segment (make-vector 0 .5)
									(make-vector 1 .5))
				)
			)
)

(define star (make-picture
				(list (make-segment (make-vector 0 .5)
									(make-vector .5 0))
					  (make-segment (make-vector .5 0)
									(make-vector 1 .5))
					  (make-segment (make-vector 1 .5)
									(make-vector .5 1))
					  (make-segment (make-vector .5 1)
									(make-vector 0 .5))
				)
			)
)

(define octagono (make-picture
	       (list (make-segment (make-vector .4 .8) (make-vector .6 .8))
		     (make-segment (make-vector .4 .8) (make-vector .2 1))
		     (make-segment (make-vector .6 .8) (make-vector .8 .6))
		     (make-segment (make-vector .6 .8) (make-vector .8 1))
		     (make-segment (make-vector .8 .6) (make-vector 1 .8))
		     (make-segment (make-vector .8 .6) (make-vector .8 .4))
		     (make-segment (make-vector .8 .4) (make-vector .6 .2))
		     (make-segment (make-vector .8 .4) (make-vector 1 .2))
		     (make-segment (make-vector .6 .2) (make-vector .4 .2))
		     (make-segment (make-vector .6 .2) (make-vector .8 0))
		     (make-segment (make-vector .4 .2) (make-vector .2 .4))
		     (make-segment (make-vector .4 .2) (make-vector .2 0))
		     (make-segment (make-vector .2 .4) (make-vector .2 .6))
		     (make-segment (make-vector .2 .4) (make-vector 0 .2))
		     (make-segment (make-vector .2 .6) (make-vector .4 .8))
		     (make-segment (make-vector .2 .6) (make-vector 0 .8))
		     )
	       )
  )
	
(define (doble pict)
  (beside pict pict .5))

(define (cuad pict)
  (above (doble pict) (doble pict) .5))


(define (anid pict n)
  (if (< n 2) pict
      (if (= n 2) (cuad pict)
	  (anid (cuad pict) (- n 1))
	  )
      )
  )

(graphics-clear ventana)







